home *** CD-ROM | disk | FTP | other *** search
/ MacHack 1994 / MacHack 1994.toast / MacHack™ 1987-1994 / MacHack™ '87 / DA's / DlgSans ƒ / myDlgSansRscr.LSP next >
Text File  |  1987-04-18  |  12KB  |  364 lines
  1. {    ;    Title: myDialogSansRscr™                                                                        }
  2. {    ;    Author    :    Paul Nevai                                                                                }
  3. {    ;    Version:    1.0                                                                                        }
  4. {    ;    April 16, 1987                                                                                    }
  5.  
  6. {    ;    This is a Use&EnjoyNetWare product: If you like it you must drop me a Thank Paul note.    }
  7.  
  8.  
  9. {    ;    Have Orthogonal Polynomials                                                                     }
  10. {    ;    Will Travel                                                                                        }
  11.  
  12. {    ;    Paul Nevai                                             pgn@osupyr.uucp ( PREFERRED )        }
  13. {    ;    Department of Mathematics                            nevai-p@osu-eddie.uucp                     }
  14. {    ;    The Ohio State University                            ...!ihnp4!cbatt!osupyr!pgn                 }
  15. {    ;    231 West Eighteenth Avenue                         TS1171@OHSTVMA.bitnet                }
  16. {    ;    Columbus, OH 43210, U. S. A.                         1-614-292-5688                        }
  17.  
  18.  
  19. {    ;    To build an FKEY Code Resource:                                                                }
  20. {    ;    (1) Remove the file "RemoveMe" and the Library "MacPasLib" from this project,            }
  21. {    ;    (2) Add the Library "DA PasLib",                                                                 }
  22. {    ;    (3) and then Build and Save As a CODE Resource with the Code Resource TYPE equal to    }
  23. {    ;     "FKEY", ID equal to "0" (Zero) which is the Key that the FKEY is installed on.                  }
  24. {    ;    The NAME should be zFKey.                                                                                    }
  25. {    ;    (4) If you want FKEY function from a MasterFKey then use ResEdit or equivalent             }
  26. {    ;    to set TYPE = FKEY and CREATOR = Paul                                                        }
  27. {    ;                                                                                                        }
  28. {    ;    Thanks to:  Lofty Becker, Steve Brecher, Carlos Weber, Joel West, the guys on the Net,    }
  29. {    ;    How to Write Macintosh Software, Inside Macintosh, Lightspeed Pascal,                    }
  30. {    ;    Macintosh Revealed                                                                                }
  31. {    ;                                                                                                        }
  32.  
  33. {    ;    This material is based upon work supported by the National Science Foundation under         }
  34. {    ;    Grant No. DMS 84-19525.                                                                        }
  35.  
  36.  
  37. UNIT zFKEY;
  38. INTERFACE
  39.  
  40.     { A code resource must have no global variables.  All shared variables are }
  41.     { local procedure MAIN, and shared among its sub procedures }
  42.  
  43.     PROCEDURE main;    { a code resource must have a procedure called MAIN }
  44.  
  45. IMPLEMENTATION
  46.  
  47.     FUNCTION PaulFilter (theDialog : DialogPtr;        {based on How to Write Macintosh Software, p. 312}
  48.                                     VAR theEvent : EventRecord;        {has some extras not fully used by this program}
  49.                                     VAR itemNumber : integer) : Boolean;
  50.         CONST
  51.             returnCode = $24;       {KeyCode}
  52.             enterCode = $34;        {KeyCode}
  53.             cancelCode = $32;        {KeyCode}
  54.             ETX = $03;               {EnterKey, charCode}
  55.             BS = $08;                {BackSpaceKey, charCode}
  56.             CR = $0D;                   {ReturnKey, charCode}
  57.             ESC = $1B;               {Clear on KeyPad, charCode}
  58.             FS = $1C;                {LeftArrow}
  59.             GS = $1D;                {RighttArrow}
  60.             RS = $1E;                {UpArrow}
  61.             US = $1F;                {DownArrow}
  62.             CancelKey = $60;          {charCode}
  63.             Finder = 3;
  64.             reallyCancel = 12;
  65.         VAR
  66.             keyCode : integer;
  67.             chCode : integer;
  68.             ch : Char;
  69.             cmdDown : Boolean;
  70.             theDialogPeek : DialogPeek;
  71.             theType : integer;
  72.             theItem : Handle;
  73.             theBox : Rect;
  74.             finalTicks : longint;
  75.     BEGIN     {PaulFilter}
  76.         theDialogPeek := DialogPeek(theDialog);
  77.         WITH theEvent DO
  78.             IF what <> keyDown THEN
  79.                 PaulFilter := FALSE
  80.             ELSE
  81.                 BEGIN
  82.                     PaulFilter := TRUE;
  83.                     keyCode := BitAnd(message, KeyCodeMask);
  84.                     keyCode := BitShift(keyCode, -8);
  85.                     chCode := BitAnd(message, CharCodeMask);
  86.                     ch := CHR(chCode);
  87.                     cmdDown := (BitAnd(modifiers, CmdKey) = CmdKey);
  88.                     IF (chCode IN [ETX, CR]) OR (ch IN ['d', 'D', 's', 'S']) THEN
  89.                         BEGIN
  90.                             GetDItem(theDialog, OK, theType, theItem, theBox);
  91.                             HiliteControl(ControlHandle(theItem), OK);
  92.                             Delay(8, finalTicks);
  93.                             HiliteControl(ControlHandle(theItem), 0);
  94.                             itemNumber := OK;
  95.                         END
  96.                     ELSE IF (chCode IN [ESC]) OR (ch IN ['`', 'c', 'C']) THEN
  97.                         BEGIN
  98.                             GetDItem(theDialog, Cancel, theType, theItem, theBox);
  99.                             HiliteControl(ControlHandle(theItem), Cancel);
  100.                             Delay(8, finalTicks);
  101.                             HiliteControl(ControlHandle(theItem), 0);
  102.                             itemNumber := Cancel;
  103.                         END
  104.                     ELSE IF (ch IN ['x', 'X']) THEN
  105.                         BEGIN
  106.                             GetDItem(theDialog, Cancel, theType, theItem, theBox);
  107.                             HiliteControl(ControlHandle(theItem), Cancel);
  108.                             Delay(20, finalTicks);
  109.                             HiliteControl(ControlHandle(theItem), 0);
  110.                             itemNumber := reallyCancel;
  111.                         END
  112.                     ELSE IF (ch IN ['f', 'F']) THEN
  113.                         BEGIN
  114.                             GetDItem(theDialog, Finder, theType, theItem, theBox);
  115.                             HiliteControl(ControlHandle(theItem), Cancel);
  116.                             Delay(8, finalTicks);
  117.                             HiliteControl(ControlHandle(theItem), 0);
  118.                             itemNumber := Finder;
  119.                         END;
  120.                 END;
  121.     END;     {PaulFilter}
  122.  
  123.     PROCEDURE DrawUserItem (theDialog : DialogPtr;        {DrawUserItem in Dialog}
  124.                                     itemNumber : integer);
  125.         VAR
  126.             itemType : integer;
  127.             itemHandle : Handle;
  128.             dispRect : Rect;
  129.     BEGIN
  130.         SetPort(theDialog);
  131.         PenSize(3, 3);
  132.         GetDItem(theDialog, OK, itemType, itemHandle, dispRect);
  133.         InsetRect(dispRect, -4, -4);
  134.         FrameRoundRect(dispRect, 16, 16);
  135.         PenNormal;
  136.     END; {DrawUserItem}
  137.  
  138.     PROCEDURE main;
  139.         CONST
  140.             ShutDown = 1;
  141.             Finder = 3;
  142.             reallyCancel = 12;
  143.         TYPE
  144.             FreudTuran = (Freud, Turan);
  145.         VAR
  146.             myDialog : DialogPtr;
  147.             myDialogPeek : DialogPeek;
  148.             dStorage : DialogRecord;
  149.             itemNumber, howManyTimes : integer;
  150.             itemType : integer;
  151.             itemHandle : Handle;
  152.             dispRect : Rect;
  153.             HMT, zMessage : str255;
  154.             justAFlag : FreudTuran;
  155.  
  156.         PROCEDURE DialogSansResources (VAR myDialog : DialogPtr;        {create Dialog in memory}
  157.                                         VAR dStorage : DialogRecord);
  158.             CONST
  159.                 CR = $0D;
  160.                 p0 = 'Please click appropriate button!';       {static text}
  161.                 line1 = 'Paul Nevai';                           {static text}
  162.                 line2 = 'pgn@osupyr.uucp';                   {static text}
  163.                 line3 = '73057,172.CompuServe';           {static text}
  164.                 line4 = 'TS1171@OHSTVMA.bitnet';           {static text}
  165.                 buttonTitleLength = 8;
  166.                 statTextLength = 2;
  167.                 buttonNu = 3;
  168.                 statTextNu = 2;
  169.                 userNu = 1;
  170.             TYPE        {these are for creating the Dialog Template in memory}
  171.                 TitleT = PACKED ARRAY[1..buttonTitleLength] OF char;
  172.                 TextT = PACKED ARRAY[1..statTextLength] OF char;
  173.                 ButtonTitleT = ARRAY[1..buttonNu] OF STRING[buttonTitleLength];
  174.                 StatTextTitleT = ARRAY[1..statTextNu] OF STRING[statTextLength];
  175.                 StatTextRectT = ARRAY[1..statTextNu] OF Rect;
  176.                 ButtonsType = ARRAY[1..buttonNu] OF RECORD
  177.                         CtlHndl : Handle;
  178.                         Itemrect : Rect;
  179.                         ItemType, ItemLen : SignedByte;
  180.                         zTitle : TitleT;
  181.                     END;
  182.                 StatTextsType = ARRAY[1..statTextNu] OF RECORD
  183.                         statTextHndl : Handle;
  184.                         Itemrect : Rect;
  185.                         ItemType, ItemLen : SignedByte;
  186.                         zText : TextT;
  187.                     END;
  188.                 UserType = ARRAY[1..userNu] OF RECORD
  189.                         userItemPtr : ProcPtr;
  190.                         Itemrect : Rect;
  191.                         ItemType, ItemLen : SignedByte;
  192.                     END;
  193.                 ItemListT = RECORD
  194.                         ItemCountM1 : integer;
  195.                         myButtons : ButtonsType;
  196.                         myStatTexts : StatTextsType;
  197.                         frame : UserType;
  198.                     END;
  199.                 ItemListTPtr = ^ItemListT;
  200.                 ItemListTHdl = ^ItemListTPtr;
  201.             VAR
  202.                 DITLHdl : ItemListTHdl;
  203.  
  204.                 frameRect, dRect : Rect;
  205.                 itemList : Handle;
  206.                 itemNumber : integer;
  207.                 zBTitle : ButtonTitleT;
  208.                 zSTTitle : StatTextTitleT;
  209.                 zSTRect : StatTextRectT;
  210.                 zAddress, theString : str255;
  211.                 i, j : integer;
  212.                 itemType : integer;
  213.                 itemHandle : Handle;
  214.                 dispRect : Rect;
  215.         BEGIN {DialogSansResources}
  216.             BEGIN {titles}
  217.                 zBTitle[1] := 'ShutDown';
  218.                 zBTitle[2] := ' Cancel ';
  219.                 zBTitle[3] := ' Finder ';
  220.                 zAddress := concat(line1, CHR(CR), line2, CHR(CR), line3, CHR(CR), line4);
  221.                 SetRect(zSTRect[1], 8, 10, 302, 39);
  222.                 SetRect(zSTRect[2], 140, 45, 300, 110);
  223.             END;
  224.             DITLHdl := ItemListTHdl(NewHandle(SizeOf(ItemListT)));      {create the DialogTemplate}
  225.             HLock(handle(DITLHdl));
  226.             WITH DITLHdl^^ DO
  227.                 BEGIN
  228.                     ItemCountM1 := buttonNu + statTextNu + userNu - 1;
  229.                     FOR j := 1 TO buttonNu DO
  230.                         WITH myButtons[j] DO
  231.                             BEGIN
  232.                                 CtlHndl := NIL;
  233.                                 BEGIN  {this little juggling places buttons in the right order on the screen}
  234.                                     IF j = 1 THEN
  235.                                         i := 2
  236.                                     ELSE IF j = 2 THEN
  237.                                         i := 3
  238.                                     ELSE IF j = 3 THEN
  239.                                         i := 1
  240.                                     ELSE
  241.                                         i := j;
  242.                                 END; {juggling}
  243.                                 SetRect(Itemrect, 10 + (i - 1) * 100, 120, 100 + (i - 1) * 100, 138);
  244.                                 IF j = 1 THEN
  245.                                     frameRect := Itemrect;
  246.                                 ItemType := CtrlItem + BtnCtrl;
  247.                                 ItemLen := buttonTitleLength;
  248.                                 zTitle := zBTitle[j];
  249.                             END;
  250.                     FOR j := 1 TO statTextNu DO
  251.                         WITH myStatTexts[j] DO
  252.                             BEGIN
  253.                                 statTextHndl := NIL;
  254.                                 Itemrect := zSTRect[j];
  255.                                 ItemType := statText;
  256.                                 ItemLen := statTextLength;
  257.                                 NumToString(j - 1, theString);
  258.                                 zText[1] := '^';
  259.                                 zText[2] := theString[1];
  260.                             END;
  261.                     WITH frame[1] DO
  262.                         BEGIN
  263.                             userItemPtr := @DrawUserItem;
  264.                             Itemrect := frameRect;
  265.                             ItemType := UserItem;
  266.                             ItemLen := 0;
  267.                         END;
  268.                 END;
  269.             HUnLock(handle(DITLHdl));
  270.             SetRect(dRect, 100, 100, 410, 250);
  271.             itemList := Handle(DITLHdl);
  272.             ParamText(p0, zAddress, '', '');
  273.             myDialog := NewDialog(@dStorage, dRect, '', TRUE, DBoxProc, WindowPtr(-1), FALSE, 0, itemList);
  274.         END; {DialogSansResources}
  275.  
  276.         PROCEDURE ExitFromTheShell (ShutItDownToo : Boolean); {based on Joel West's NetWare}
  277.             TYPE
  278.                 VCBPtr = ^VCB;
  279.             VAR
  280.                 vcbp : VCBPtr;
  281.                 refnumStartUp, refnum, dmyerr : INTEGER;
  282.                 kjuHeaderPtr : QHdrPtr;
  283.         BEGIN
  284.             kjuHeaderPtr := GetVCBQHdr;
  285.             vcbp := VCBPtr(kjuHeaderPtr^.QHead);
  286.             refnumStartUp := vcbp^.vcbVRefNum;
  287.             WHILE vcbp <> NIL DO
  288.                 BEGIN
  289.                     refnum := vcbp^.vcbVRefNum;
  290.                     vcbp := VCBPtr(vcbp^.qLink);
  291.                     dmyerr := FlushVol(NIL, refnum);
  292.                     IF ShutItDownToo THEN
  293.                         IF refnumStartUp <> refnum THEN
  294.                             BEGIN
  295.                                 dmyerr := Eject(NIL, refnum);
  296.                                 dmyerr := UnmountVol(NIL, refnum);
  297.                             END;
  298.                 END;
  299.             IF ShutItDownToo THEN
  300.                 BEGIN
  301.                     dmyerr := Eject(NIL, refnumStartUp);
  302.                     dmyerr := UnmountVol(NIL, refnumStartUp);
  303.                     ReStart
  304.                 END
  305.             ELSE
  306.                 ExitToShell;
  307.         END;  {ExitFromTheShell (ShutItDownToo : Boolean)}
  308.  
  309.     BEGIN {main}
  310.         howManyTimes := 0;
  311.         justAFlag := Freud;            {kludge,kludge}
  312.         DialogSansResources(myDialog, dStorage);
  313.         FlushEvents(everyEvent, 0);
  314.         InitCursor;
  315.         REPEAT
  316.             ModalDialog(@PaulFilter, itemNumber);
  317.             IF itemNumber = Cancel THEN
  318.                 BEGIN
  319.                     GetDItem(myDialog, 4, itemType, itemHandle, dispRect);
  320.                     CASE howManyTimes OF
  321.                         0 : 
  322.                             BEGIN
  323.                                 zMessage := 'Good Job! Alas, there is no way to cancel it.';
  324.                                 howManyTimes := 1;
  325.                             END;
  326.                         1 : 
  327.                             BEGIN
  328.                                 zMessage := 'Sorry, but I told you already that you can''t cancel it.';
  329.                                 howManyTimes := howManyTimes + 1;
  330.                             END;
  331.                         OTHERWISE
  332.                             IF (justAFlag = Freud) AND (howManyTimes = 5 * trunc(howManyTimes / 5)) THEN
  333.                                 BEGIN
  334.                                     zMessage := 'OK, you can cancel it by typing ''x'' or ''X''.';
  335.                                     justAFlag := Turan;            {kludge,kludge}
  336.                                 END
  337.                             ELSE
  338.                                 BEGIN
  339.                                     NumToString(howManyTimes, HMT);
  340.                                     zMessage := concat('Didn''t I tell you ', HMT, ' times already that you can''t cancel it?');
  341.                                     SetIText(itemHandle, zMessage);
  342.                                     howManyTimes := howManyTimes + 1;
  343.                                     justAFlag := Freud;            {kludge,kludge}
  344.                                 END;
  345.                     END; {case howManyTimes of}
  346.                     SetIText(itemHandle, zMessage);
  347.                 END; {itemNumber = zCancel}
  348.         UNTIL itemNumber IN [ShutDown, Finder, reallyCancel];
  349.         myDialogPeek := DialogPeek(myDialog);
  350.         CloseDialog(myDialog);
  351.         DisposHandle(myDialogPeek^.items);
  352.         CASE itemNumber OF
  353.             ShutDown : 
  354.                 ExitFromTheShell(TRUE);
  355.             Finder : 
  356.                 ExitFromTheShell(FALSE);
  357.             reallyCancel : 
  358.                 ;                                             {typing either 'x' or'X' lets one really cancel the Dialog}
  359.             OTHERWISE
  360.                 ExitFromTheShell(FALSE);
  361.         END;
  362.     END;    { main }
  363.  
  364. END.    { unit }